home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap11 / howto05 / ccicnntp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-27  |  50.3 KB  |  1,395 lines

  1. unit Ccicnntp;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  8.   CCICCPrf, IniFiles, Gauges , CCUUCode, CCiccfrm;
  9. type
  10.   { Component to hold NNTP handling capabilities }
  11.   TNNTPComponent = class( TWinControl )
  12.   public
  13.     NNTPCommandInProgress ,
  14.     Connection_Established : Boolean;
  15.     Socket1 : TCCSocket;
  16.     constructor Create( AOwner : TComponent ); override;
  17.     destructor Destroy; override;
  18.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  19.     function Disconnect : Boolean;
  20.     function DoCStyleFormat(       TheText      : string;
  21.                              const TheArguments : array of const ) : String;
  22.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  23.     procedure AddProgressText( WhatText : String );
  24.     procedure ShowProgressText( WhatText : String );
  25.     procedure ShowProgressErrorText( WhatText : String );
  26.     function GetNNTPServerResponse( var ResponseString : String ) : integer;
  27.     procedure NNTPSocketsErrorOccurred( Sender     : TObject;
  28.                                      ErrorCode  : Integer;
  29.                                      TheMessage : String   );
  30.     function PerformNNTPCommand(
  31.                     TheCommand   : string;
  32.               const TheArguments : array of const ) : Integer;
  33.     function PerformBlindNNTPCommand( TheCommand   : string ) : Integer;
  34.     function PerformNNTPExtendedCommand(
  35.                     TheCommand   : string;
  36.               const TheArguments : array of const ) : Integer;
  37.     function GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
  38.     function GetNextSDItem(     WorkingString : String;
  39.                             var TheIndex      : Integer ) : String;
  40.     function GetListOfAvailableNewsGroups : Boolean;
  41.     function PurgeReadSentArticleListings( TheNGRecord : PNewsGroupRecord ): Boolean;
  42.     procedure ParseNewsGroupListing(     TheListing : String;
  43.                                      var GroupName  : String;
  44.                                      var LowCurrent : Longint;
  45.                                      var HighCurrent : Longint;
  46.                                      var Postable    : Boolean  );
  47.     function SetCurrentNewsGroup( TheNGRecord : PNewsGroupRecord;
  48.                                   DoUpdate    : Boolean           ) : Boolean;
  49.     function CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
  50.     function CheckAllNewNews : Boolean;
  51.     function SetNewsHeaders( TheMemo     : TMemo ;
  52.                              GroupNumber : Integer ) : Boolean;
  53.     function SetFUNewsHeaders( TheMemo         : TMemo ;
  54.                                GroupNumber   ,
  55.                                ArticleNumber   : Integer ) : Boolean;
  56.     procedure ParseArticleListing(     TheListing       : String;
  57.                                    var TotalAvailable   : Longint;
  58.                                    var LowestAvailable  : Longint;
  59.                                    var HighestAvailable : Longint );
  60.     function GetArticleHeader( TheNumber     : Longint;
  61.                                TheReturnList : TStringList ) : Boolean;
  62.     function GetAllArticleHeaders( TheNGRecord : PNewsGroupRecord ) : Boolean;
  63.     function DownloadArticleListing( TheNumber : Longint;
  64.                                      TheFileName : String ) : Boolean;
  65.     function DownloadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
  66.     function UploadArticleListing( TheNGARecord : PNewsGroupArticleRecord ) : Boolean;
  67.     function UploadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
  68.     function GetHeaderSubject( HList : TStringList ) : String;
  69.     function GetHeaderSender( HList : TStringList ) : String;
  70.     function DownloadAllMarkedArticleListings( TheNGRecord : PNewsGroupRecord;
  71.                                                TheListbox  : TListbox          ) : Boolean;
  72.   end;
  73.  
  74. implementation
  75.  
  76. { This function calls an extended response NNTP command routine }
  77. function TNNTPComponent.PerformNNTPExtendedCommand(
  78.                TheCommand   : string;
  79.          const TheArguments : array of const ) : Integer;
  80. var TheBuffer : string; { Text buffer }
  81. begin
  82.   { If command in progress send back -1 error }
  83.   if NNTPCommandInProgress then
  84.   begin
  85.     Result := -1;
  86.     exit;
  87.   end;
  88.   { Set status variable }
  89.   NNTPCommandInProgress := True;
  90.   { Set global error code }
  91.   GlobalErrorCode := 0;
  92.   { Format output string }
  93.   TheBuffer := Format( TheCommand , TheArguments );
  94.   { Preset failure code }
  95.   Result := TCPIP_STATUS_FATAL_ERROR;
  96.   { If invalid socket or no connection abort }
  97.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  98.    exit;
  99.   { Send the buffer plus EOL chars }
  100.   Socket1.StringData := TheBuffer + #13#10;
  101.   { if abort due to timeout or other error exit }
  102.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  103.   { Otherwise return preliminary code }
  104.   Result := TCPIP_STATUS_PRELIMINARY;
  105. end;
  106.  
  107. { This function gets an extended period-ended multiline response from the server }
  108. function TNNTPComponent.GetNNTPServerExtendedResponse( ResponseString : PChar ) : integer;
  109. var
  110.   { Assume ResponseString already allocated as 0..513 }
  111.   { Pointer to the response string }
  112.   TheBuffer ,
  113.   BufferPointer : array[0..255] of char;
  114.   HolderBuffer : array[0..513] of char;
  115.   { Character to check for response code }
  116.   ResponseChar   : char;
  117.   { Pointers into returned string }
  118.   TheIndex ,
  119.   TheLength     : integer;
  120.   { Control variable }
  121.   LeftoversInPan ,
  122.   Finished      : Boolean;
  123.   BufferString : String;
  124. begin
  125.   { Preset fatal error }
  126.   Result := TCPIP_STATUS_FATAL_ERROR;
  127.   { Start loop control }
  128.   LeftoversInPan := false;
  129.   Finished := false;
  130.   StrCopy( HolderBuffer , '' );
  131.   repeat
  132.     { Do a peek }
  133.     BufferString := Socket1.PeekData;
  134.     { If timeout or other error exit }
  135.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  136.     { Find end of line character }
  137.     TheIndex := Pos( #10 , BufferString );
  138.     if TheIndex = 0 then
  139.     begin
  140.       TheIndex := Pos( #13 , BufferString );
  141.       if TheIndex = 0 then
  142.       begin
  143.         TheIndex := Pos( #0 , BufferString );
  144.         if TheIndex = 0 then
  145.         begin
  146.           TheIndex := Length( BufferString );
  147.           LeftoversInPan := True;
  148.           StrPCopy( TheBuffer , BufferString );
  149.           StrCat( HolderBuffer , TheBuffer );
  150.           LeftoversOnTable := false;
  151.         end;
  152.       end;
  153.     end;
  154.     { If an end of line then process the line }
  155.     if TheIndex > 0 then
  156.     begin
  157.       { Get length of string }
  158.       TheLength := TheIndex;
  159.       { Receive actual data }
  160.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  161.                              @BufferPointer[ 0 ] ,
  162.                              TheLength              );
  163.       { Abort if timeout or error }
  164.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  165.       { Put in the length byte }
  166.       BufferPointer[ TheLength ] := Chr( 0 );
  167.       if LeftOversOnTable then
  168.       begin
  169.         LeftOversOnTable := false;
  170.         StrCopy( ResponseString , HolderBuffer );
  171.         StrCat( ResponseString , BufferPointer );
  172.       end
  173.       else
  174.       begin
  175.         if not LeftoversInPan then StrCopy( ResponseString , BufferPointer );
  176.       end;
  177.       if LeftoversInPan then
  178.       begin
  179.         LeftoversInPan := false;
  180.         LeftoversOnTable := true;
  181.       end
  182.       else
  183.       begin
  184.         ResponseChar := ResponseString[ 0 ];
  185.         if (( ResponseChar = '.' ) and ( StrLen( ResponseString ) <= 3 )) then
  186.         begin
  187.           Finished := true;
  188.           Result := TCPIP_STATUS_COMPLETED;
  189.         end
  190.         else
  191.         begin
  192.           if ResponseChar = '.' then ResponseString[ 0 ] := ' ';
  193.           Finished := true;
  194.           Result := TCPIP_STATUS_PRELIMINARY;
  195.         end;
  196.       end;
  197.     end;
  198.   until ( Finished and ( not LeftoversOnTable ));
  199.   StrLCopy( ResponseString , ResponseString , StrLen( ResponseString ) - 2 );
  200. end;
  201.  
  202. { This function moves along a string from an index, getting the next }
  203. { string delimited item or last one on string.                       }
  204. function TNNTPComponent.GetNextSDItem(     WorkingString : String;
  205.                                        var TheIndex      : Integer ) : String;
  206. var HoldingString : String;
  207. begin
  208.   HoldingString := Copy( WorkingString , TheIndex + 1 , 255 );
  209.   TheIndex := Pos( ' ' , HoldingString );
  210.   if TheIndex = 0 then
  211.   begin
  212.     Result := HoldingString;
  213.   end
  214.   else
  215.   begin
  216.     HoldingString := Copy( HoldingString , 1 , TheIndex - 1 );
  217.     Result := HoldingString;
  218.   end;
  219. end;
  220.  
  221. { This is the first true "network" function; it sends a LIST command, eats }
  222. { a single 215 response and then grabs PChars of data from the server till }
  223. { It returns a period character. The returned line is sent to a NEWSGRP    }
  224. { file and a status update is send through.                                }
  225. function TNNTPComponent.GetListOfAvailableNewsGroups : Boolean;
  226. var TheReturnString : String;  { Internal string holder }
  227.     TheResult       : Integer; { Internal int holder    }
  228.     HoldPChar ,
  229.     TheHoldingPChar ,
  230.     TheReturnPChar  : PChar;
  231.     TheNGFile       : TextFile;
  232.     D1 , D2     : Longint;
  233.     D3          : Boolean;
  234.     GroupString : String;
  235.     TotalGroups : Longint;
  236. begin
  237.   Result := false;
  238.   TheReturnString :=
  239.    DoCStyleFormat( 'LIST' ,
  240.     [ nil ] );
  241.   { Put result in progress and status line }
  242.   AddProgressText( TheReturnString );
  243.   ShowProgressText( TheReturnString );
  244.   { Begin login sequence with user name }
  245.   TheResult := PerformNNTPCommand( 'LIST', [ nil ] );
  246.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  247.   begin
  248.     NNTPCommandInProgress := false;
  249.     Result := false;
  250.     exit;
  251.   end;
  252.   repeat
  253.     TheResult := GetNNTPServerResponse( TheReturnString );
  254.     { Put result in progress and status line }
  255.     AddProgressText( TheReturnString );
  256.     ShowProgressText( TheReturnString );
  257.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  258.   NNTPCommandInProgress := false;
  259.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  260.   begin
  261.     { Do clever C formatting trick }
  262.     TheReturnString :=
  263.      DoCStyleFormat( 'LIST Failed!' ,
  264.       [ nil ] );
  265.     { Put result in progress and status line }
  266.     AddProgressText( TheReturnString );
  267.     ShowProgressErrorText( TheReturnString );
  268.     { Signal error }
  269.     Result := False;
  270.     { leave }
  271.     exit;
  272.   end;
  273.   try
  274.     AssignFile( TheNGFile , NewsPath + '\NEWSGRP.TXT' );
  275.     Rewrite( TheNGFile );
  276.   except
  277.     Socket1.OutOfBand := 'ABOR'+#13#10;
  278.     repeat
  279.       TheResult := GetNNTPServerResponse( TheReturnString );
  280.       { Put result in progress and status line }
  281.       AddProgressText( TheReturnString );
  282.       ShowProgressText( TheReturnString );
  283.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  284.     Result := false;
  285.     exit;
  286.   end;
  287.   GetMem( TheReturnPChar , 514 );
  288.   HoldPChar := TheReturnPChar;
  289.   TotalGroups := 0;
  290.   CCICInfoDlg.ListBox1.Clear;
  291.   repeat
  292.     Application.ProcessMessages;
  293.     if GlobalAbortedFlag then exit;
  294.     Inc(TotalGroups );
  295.     TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
  296.     if StrLen( TheReturnPChar ) > 255 then
  297.     begin
  298.       Getmem( TheHoldingPChar , 255 );
  299.       while StrLen( TheReturnPChar ) > 255 do
  300.       begin
  301.         StrCopy( TheHoldingPChar , '' );
  302.         StrMove( TheHoldingPChar , TheReturnPChar , 255 );
  303.         TheReturnPChar := TheReturnPChar + 256;
  304.         TheReturnString := StrPas( TheHoldingPChar );
  305.         ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
  306.       end;
  307.       FreeMem( TheHoldingPChar , 255 );
  308.       Writeln( TheNGFile , GroupString );
  309.       CCICInfoDlg.ListBox1.Items.Add( GroupString );
  310.       CCINetCCForm.Panel1.Caption := GroupString +
  311.        '(' + IntToStr( TotalGroups ) + ')';
  312.     end
  313.     else
  314.     begin
  315.       TheReturnString := StrPas( TheReturnPChar );
  316.       ParseNewsGroupListing( TheReturnString, GroupString, D1 , D2 , D3 );
  317.       Writeln( TheNGFile , GroupString );
  318.       CCICInfoDlg.ListBox1.Items.Add( GroupString );
  319.       CCINetCCForm.Panel1.Caption := GroupString +
  320.        '(' + IntToStr( TotalGroups ) + ')';
  321.     end;
  322.   until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  323.   FreeMem( HoldPChar , 514 );
  324.   CloseFile( TheNGFile );
  325.   Result := true;
  326.   CCINetCCForm.Panel1.Caption := 'Finished LIST!';
  327. end;
  328.  
  329. { This method sets a news group and updates its internal data }
  330. function TNNTPComponent.CheckForNewNews( TheNGRecord : PNewsGroupRecord ) : Boolean;
  331. begin
  332.   { Gee, that was easy! }
  333.   Result := SetCurrentNewsGroup( TheNGRecord , true );
  334. end;
  335.  
  336. { This method puts all the headers into the memo, getting the group name from gn }
  337. function TNNTPComponent.SetNewsHeaders( TheMemo     : TMemo ;
  338.                                         GroupNumber : Integer ) : Boolean;
  339. var TheNGRecord : PNewsGroupRecord;
  340.     DateString , TimeString : String;
  341. begin
  342.   TheMemo.Clear;
  343.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ GroupNumber ] );
  344.   TheMemo.Lines.Add( 'Newsgroups:' + TheNGRecord^.GRealName );
  345.   TheMemo.Lines.Add( 'From:' );
  346.   TheMemo.Lines.Add( 'Subject:');
  347.   TheMemo.Lines.Add( 'Organization: CIUPKC Software' );
  348.   TheMemo.Lines.Add( 'Reply-To:' );
  349.   TheMemo.Lines.Add( 'X-Newsreader: CC Internet Command Center' );
  350.   DateString := DateToStr( Date ) + ' ';
  351.   TimeString := TimeToStr( Time );
  352.   TheMemo.Lines.Add( 'Date: ' + DateString  + TimeString );
  353.   TheMemo.Lines.Add( '' );
  354.   Result := true;
  355. end;
  356.  
  357. { This function adds the text of an article to the current memo with > }
  358. function TNNTPComponent.SetFUNewsHeaders( TheMemo         : TMemo ;
  359.                                         GroupNumber   ,
  360.                                         ArticleNumber   : Integer ) : Boolean;
  361. var WorkingList   : TList;
  362.     TheNGRecord   : PNewsGroupRecord;
  363.     TheNGARecord  : PNewsGroupArticleRecord;
  364.     Counter_1 : Integer;
  365.     WorkingFileName : String;
  366.     DateString , TimeString : String;
  367. begin
  368.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ GroupNumber ] );
  369.   WorkingList := TList( TheNGRecord^.GLTag );
  370.   TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ ArticleNumber ] );
  371.   WorkingFileName := TheNGARecord^.NGAArtFileName;
  372.   WorkingFileName := NewsPath + '\' + WorkingFileName;
  373.   TheMemo.Lines.LoadFromFile( WorkingFileName );
  374.   for Counter_1 := 0 to TheMemo.Lines.Count - 1 do
  375.    TheMemo.Lines[ Counter_1 ] := '>' + TheMemo.Lines[ Counter_1 ];
  376.   TheMemo.Lines.Insert( 0 , 'Newsgroups: ' + TheNGRecord^.GRealName );
  377.   TheMemo.Lines.Insert( 1 , 'From: ' );
  378.   TheMemo.Lines.Insert( 2 , 'Subject: ');
  379.   TheMemo.Lines.Insert( 3 , 'Organization: CIUPKC Software' );
  380.   TheMemo.Lines.Insert( 4 , 'Reply-To: ' );
  381.   TheMemo.Lines.Insert( 5 , 'X-Newsreader: CC Internet Command Center' );
  382.   DateString := DateToStr( Date ) + ' ';
  383.   TimeString := TimeToStr( Time );
  384.   TheMemo.Lines.Insert( 6 , 'Date: ' + DateString  + TimeString );
  385.   TheMemo.Lines.Insert( 7 , '' );
  386.   Result := true;
  387. end;
  388.  
  389. { This method takes all the data in the NewsRCList and if subscribed, CNN's it }
  390. function TNNTPComponent.CheckAllNewNews : Boolean;
  391. var Counter_1   : Integer;
  392.     TheNGRecord : PNewsGroupRecord;
  393. begin
  394.   Result := true;
  395.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  396.   begin
  397.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  398.     if TheNGRecord^.GSubScribed then Result := CheckForNewNews( TheNGRecord );
  399.   end;
  400. end;
  401.  
  402. { This method splits up a listing and pulls out its component data }
  403. procedure TNNTPComponent.ParseNewsGroupListing(     TheListing : String;
  404.                                 var GroupName  : String;
  405.                                 var LowCurrent : Longint;
  406.                                 var HighCurrent : Longint;
  407.                                 var Postable    : Boolean  );
  408. var HoldingString ,
  409.     HoldingString2 : String;
  410.     WorkingIndex  : Integer;
  411. begin
  412.   WorkingIndex := Pos( ' ' , TheListing );
  413.   if WorkingIndex = 0 then
  414.   begin
  415.     GroupName := TheListing;
  416.     LowCurrent :=  -1;
  417.     HighCurrent := -1;
  418.     Postable := false;
  419.     exit;
  420.   end;
  421.   GroupName := Copy( TheListing , 1 , WorkingIndex - 1 );
  422.   HoldingString := Copy( TheListing , WorkingIndex + 1 , 255 );
  423.   WorkingIndex := Pos(  ' ' , HoldingString );
  424.   HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  425.   LowCurrent := StrToInt( HoldingString2 );
  426.   HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
  427.   WorkingIndex := Pos(  ' ' , HoldingString );
  428.   HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  429.   HighCurrent := StrToInt( HoldingString2 );
  430.   HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
  431.   if (( HoldingString[ 1 ] = 'y' ) or ( HoldingString[ 1 ] = 'Y' )) then
  432.    Postable := true else Postable := false;
  433. end;
  434.  
  435. { This is another "Network" command which sets the GROUP to the name of the }
  436. { imported record. The imported record is also updated to reflect current   }
  437. { available articles.                                                       }
  438. function TNNTPComponent.SetCurrentNewsGroup(
  439.           TheNGRecord : PNewsGroupRecord; DoUpdate : Boolean ) : Boolean;
  440. var TheReturnString : String;  { Internal string holder }
  441.     TheResult       : Integer; { Internal int holder    }
  442.     TAA , LAA , HAA : Longint;
  443. begin
  444.   TheReturnString :=
  445.    DoCStyleFormat( 'GROUP %s' ,
  446.     [ TheNGRecord^.GRealName ] );
  447.   { Put result in progress and status line }
  448.   AddProgressText( TheReturnString );
  449.   ShowProgressText( TheReturnString );
  450.   { Begin login sequence with user name }
  451.   TheResult := PerformNNTPCommand( 'GROUP %s',
  452.                                   [ TheNGRecord^.GRealName ] );
  453.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  454.   begin
  455.     NNTPCommandInProgress := false;
  456.     Result := false;
  457.     exit;
  458.   end;
  459.   repeat
  460.     TheResult := GetNNTPServerResponse( TheReturnString );
  461.     { Put result in progress and status line }
  462.     AddProgressText( TheReturnString );
  463.     ShowProgressText( TheReturnString );
  464.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  465.   NNTPCommandInProgress := false;
  466.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  467.   begin
  468.     { Do clever C formatting trick }
  469.     TheReturnString :=
  470.      DoCStyleFormat( 'GROUP %s Not Available!' ,
  471.       [ TheNGRecord^.GRealName ] );
  472.     { Put result in progress and status line }
  473.     AddProgressText( TheReturnString );
  474.     ShowProgressErrorText( TheReturnString );
  475.     { Signal error }
  476.     Result := False;
  477.     { leave }
  478.     exit;
  479.   end;
  480.   Result := True;
  481.   { Leave if only want to set group }
  482.   if not DoUpdate then exit;
  483.   { Split out the articles listing into its three numbers }
  484.   ParseArticleListing( TheReturnString , TAA , LAA , HAA );
  485.   { Work on the numbers to make sure display is consistent }
  486.   with TheNGRecord^ do
  487.   begin
  488.     { Set internal pointers }
  489.     GTotalAvailable := TAA;
  490.     GLowestAvailable := LAA;
  491.     GHighestAvailable := HAA;
  492.     if GLowest < GLowestAvailable then
  493.     begin { All stored articles have expired or there are none }
  494.       GTotalNew := GTotalAvailable;      { Total new is total available    }
  495.       GLowest := GLowestAvailable - 1;   { set low and high to below start }
  496.       GHighest := GLowestAvailable - 1; { until something is read }
  497.     end
  498.     else
  499.     begin { Some read articles haven't expired; assume all still good }
  500.       GTotalNew := GHighestAvailable - GHighest; { Total since last download }
  501.       if GTotalNew < 0 then GTotalNew := 0; { Just in case... }
  502.     end;
  503.   end;
  504. end;
  505.  
  506. { This method splits out the GROUP response line into TAA, LAA , HAA }
  507. procedure TNNTPComponent.ParseArticleListing(     TheListing       : String;
  508.                               var TotalAvailable   : Longint;
  509.                               var LowestAvailable  : Longint;
  510.                               var HighestAvailable : Longint );
  511. var WorkingString ,
  512.     WorkingString2 : String;
  513.     WorkingIndex   : Integer;
  514. begin
  515.   WorkingString := Copy( TheListing , 5, 255 );
  516.   WorkingIndex := Pos( ' ' , WorkingString );
  517.   WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  518.   TotalAvailable := StrToInt( WorkingString2 );
  519.   WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
  520.   WorkingIndex := Pos( ' ' , WorkingString );
  521.   WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  522.   LowestAvailable := StrToInt( WorkingString2 );
  523.   WorkingString := Copy( WorkingString , WorkingIndex + 1 , 255 );
  524.   WorkingIndex := Pos( ' ' , WorkingString );
  525.   WorkingString2 := Copy( WorkingString , 1 , WorkingIndex - 1 );
  526.   HighestAvailable := StrToInt( WorkingString2 );
  527. end;
  528.  
  529. { This method uses the HEAD command to get a complete article header }
  530. function TNNTPComponent.GetArticleHeader( TheNumber     : Longint;
  531.                           TheReturnList : TStringList ) : Boolean;
  532. var TheReturnString : String;  { Internal string holder }
  533.     TheResult       : Integer; { Internal int holder    }
  534.     HoldPChar ,
  535.     TheReturnPChar ,
  536.     TheHoldingPChar : PChar;
  537. begin
  538.   TheReturnString :=
  539.    DoCStyleFormat( 'HEAD %d' ,
  540.     [ TheNumber ] );
  541.   { Put result in progress and status line }
  542.   AddProgressText( TheReturnString );
  543.   ShowProgressText( TheReturnString );
  544.   { Begin login sequence with user name }
  545.   TheResult := PerformNNTPCommand( 'HEAD %d', [ TheNumber ] );
  546.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  547.   begin
  548.     NNTPCommandInProgress := false;
  549.     Result := false;
  550.     exit;
  551.   end;
  552.   repeat
  553.     TheResult := GetNNTPServerResponse( TheReturnString );
  554.     { Put result in progress and status line }
  555.     AddProgressText( TheReturnString );
  556.     ShowProgressText( TheReturnString );
  557.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  558.   NNTPCommandInProgress := false;
  559.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  560.   begin
  561.     { Do clever C formatting trick }
  562.     TheReturnString :=
  563.      DoCStyleFormat( 'Head %d Failed!' ,
  564.       [ TheNumber ] );
  565.     { Put result in progress and status line }
  566.     AddProgressText( TheReturnString );
  567.     ShowProgressErrorText( TheReturnString );
  568.     { Signal error }
  569.     Result := False;
  570.     { leave }
  571.     exit;
  572.   end;
  573.   GetMem( TheReturnPChar , 514 );
  574.   HoldPChar := TheReturnPchar;
  575.   TheReturnList.Clear;
  576.   repeat
  577.     TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
  578.     if StrLen( TheReturnPChar ) > 255 then
  579.     begin
  580.       Getmem( TheHoldingPChar , 255 );
  581.       while StrLen( TheReturnPChar ) > 255 do
  582.       begin
  583.         StrCopy( TheHoldingPChar , '' );
  584.         StrMove( TheHoldingPChar , TheReturnPChar , 255 );
  585.         TheReturnPChar := TheReturnPChar + 256;
  586.         TheReturnString := StrPas( TheHoldingPChar );
  587.         TheReturnList.Add( TheReturnString );
  588.       end;
  589.       StrCopy( TheHoldingPChar , '' );
  590.       StrMove( TheHoldingPChar , TheReturnPChar , StrLen( TheReturnPChar ));
  591.       TheReturnString := StrPas( TheHoldingPChar );
  592.       TheReturnString := '\' + TheReturnString;
  593.       TheReturnList.Add( TheReturnString );
  594.       FreeMem( TheHoldingPChar , 255 );
  595.     end
  596.     else
  597.     begin
  598.       TheReturnString := StrPas( TheReturnPChar );
  599.       TheReturnList.Add( TheReturnString );
  600.     end;
  601.   until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  602.   FreeMem( HoldPChar , 514 );
  603.   Result := true;
  604. end;
  605.  
  606. { This method parses a header stringlist and obtains the subject line }
  607. function TNNTPComponent.GetHeaderSubject( HList : TStringList ) : String;
  608. var Counter_1     : Integer;
  609.     Finished      : Boolean;
  610.     WorkingIndex  : Integer;
  611.     WorkingString : String;
  612. begin
  613.   Counter_1 := 0;
  614.   Finished := false;
  615.   WorkingString := '[No Subject]';
  616.   while (( not Finished ) and ( Counter_1 < HList.Count - 1 )) do
  617.   begin
  618.     WorkingIndex := Pos( 'SUBJECT:' , Uppercase( HList.Strings[ Counter_1 ] ));
  619.     if WorkingIndex > 0 then
  620.     begin
  621.       WorkingString := Copy( HList.Strings[ Counter_1 ] , 9 , 255 );
  622.       Finished := true;
  623.     end
  624.     else Counter_1 := Counter_1 + 1;
  625.   end;
  626.   Result := WorkingString;
  627. end;
  628.  
  629. { This method parses a header stringlist and obtains the sender's ID }
  630. function TNNTPComponent.GetHeaderSender( HList : TStringList ) : String;
  631. var Counter_1     : Integer;
  632.     Finished      : Boolean;
  633.     WorkingIndex  : Integer;
  634.     WorkingString : String;
  635. begin
  636.   Counter_1 := 0;
  637.   Finished := false;
  638.   WorkingString := '';
  639.   while (( not Finished ) and ( Counter_1 < HList.Count - 1 )) do
  640.   begin
  641.     WorkingIndex := Pos( 'FROM:' , Uppercase( HList.Strings[ Counter_1 ] ));
  642.     if WorkingIndex > 0 then
  643.     begin
  644.       WorkingString := Copy( HList.Strings[ Counter_1 ] , 6 , 255 );
  645.       Finished := true;
  646.     end
  647.     else Counter_1 := Counter_1 + 1;
  648.   end;
  649.   Result := WorkingString;
  650. end;
  651.  
  652.  
  653. { This method updates the available headers in the header file for a newsgroup }
  654. function TNNTPComponent.GetAllArticleHeaders( TheNGRecord : PNewsGroupRecord ) : Boolean;
  655. var TheNGARecord   : PNewsGroupArticleRecord;
  656.     Counter_1      : Integer;
  657.     TheHeaderList  : TStringList;
  658.     WorkingList    : TList;
  659.     WorkingCounter : Longint;
  660. begin
  661.   { Do this for ease of coding }
  662.   with TheNGRecord^ do
  663.   begin
  664.     { Get the current TList of article headers }
  665.     WorkingList := TList( GLTag );
  666.     { Set Group Command without updating }
  667.     if not SetCurrentNewsGroup( TheNGRecord , false ) then
  668.     begin
  669.       { Abort if can't get newsgroup }
  670.       Result := false;
  671.       exit;
  672.     end;
  673.     { create the stringlist for header info }
  674.     TheHeaderList := TStringList.Create;
  675.     { Determine how many to get from computed availability }
  676.     WorkingCounter := GHighestAvailable - GTotalNew + 1;
  677.     { Run up to total new articles }
  678.     for Counter_1 := 1 to GTotalNew do
  679.     begin
  680.       { Try to get the header }
  681.       if GetArticleHeader( WorkingCounter , TheHeaderList ) then
  682.       begin
  683.         { If succeed create new header record }
  684.         New( TheNGARecord );
  685.         with TheNGARecord^ do
  686.         begin
  687.           { Fill in all the fields with nominal or acquired data }
  688.           NGAGroupname   := GRealName;
  689.           NGASubject     := GetHeaderSubject( TheHeaderList );
  690.           NGANumber      := WorkingCounter;
  691.           NGADownloaded  := false;
  692.           NGASender      := GetHeaderSender( TheHeaderList );
  693.           NGARead        := false;
  694.           NGAPosted      := false;
  695.           NGAArtFileName := '';
  696.         end;
  697.         { Put record on list }
  698.         WorkingList.Add( TheNGARecord );
  699.       end;
  700.       { Either way increment the counter }
  701.       WorkingCounter := WorkingCounter + 1;
  702.     end;
  703.     { Update all the pointer numbers to indicate all article headers gotten }
  704.     GTotalUnreadArticles := GTotalUnreadArticles + GTotalAvailable;
  705.     GTotalArticles := GTotalArticles + GTotalAvailable;
  706.     GTotalAvailable := 0;
  707.     GTotalNew := 0;
  708.     GLowestAvailable := GHighestAvailable;
  709.     GLowest := GLowestAvailable;
  710.     GHighest := GLowestAvailable;
  711.     { Save off the pointer to the modified TList }
  712.     GLTag := Longint( WorkingList );
  713.     { Clean Up and leave }
  714.     Result := true;
  715.     TheHeaderList.Free;
  716.   end;
  717. end;
  718.  
  719. { This function deletes all read/sent articles and associated files }
  720. function TNNTPComponent.PurgeReadSentArticleListings(
  721.  TheNGRecord : PNewsGroupRecord ) : Boolean;
  722. var TheNGARecord   : PNewsGroupArticleRecord;
  723.     Counter_1      : Integer;
  724.     WorkingList    : TList;
  725.     Finished       : Boolean;
  726. begin
  727.   { Do this for ease of coding }
  728.   with TheNGRecord^ do
  729.   begin
  730.     { Get the current TList of article headers }
  731.     WorkingList := TList( GLTag );
  732.     { Run up to total new articles }
  733.     for Counter_1 := 0 to WorkingList.Count - 1 do
  734.     begin
  735.       TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  736.       if ( TheNGARecord^.NGAPosted or TheNGARecord^.NGARead ) then
  737.       begin
  738.         Dec( GTotalArticles );
  739.         if FileExists( NewsPath + '\' + TheNGARecord^.NGAArtFilename ) then
  740.          {DeleteFile( NewsPath + '\' + TheNGARecord^.NGAArtFileName )};
  741.       end;
  742.     end;
  743.     Counter_1 := 0;
  744.     Finished := False;
  745.     while Not Finished do
  746.     begin
  747.       TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  748.       if ( TheNGARecord^.NGAPosted or TheNGARecord^.NGARead ) then
  749.       begin
  750.         WorkingList.Delete( Counter_1 );
  751.       end
  752.       else Counter_1 := Counter_1 + 1;
  753.       if Counter_1 > WorkingList.Count - 1 then Finished := true;
  754.     end;
  755.   end;
  756.   Result := true;
  757. end;
  758.  
  759. { This method uses the ARTICLE command to obtain an article and put it in a  }
  760. { preset/supplied file. It is designed to work by itself or inside DAALs     }
  761. function TNNTPComponent.DownloadArticleListing( TheNumber   : Longint;
  762.                                                 TheFileName : String   ) : Boolean;
  763. var TheReturnString : String;  { Internal string holder }
  764.     TheResult       : Integer; { Internal int holder    }
  765.     HoldPChar ,
  766.     TheReturnPChar ,
  767.     TheHoldingPChar : PChar;
  768.     TheArticleFile       : TextFile;
  769. begin
  770.   TheReturnString :=
  771.    DoCStyleFormat( 'ARTICLE %d' ,
  772.     [ TheNumber ] );
  773.   { Put result in progress and status line }
  774.   AddProgressText( TheReturnString );
  775.   ShowProgressText( TheReturnString );
  776.   { Begin login sequence with user name }
  777.   TheResult := PerformNNTPCommand( 'ARTICLE %d', [ TheNumber ] );
  778.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  779.   begin
  780.     NNTPCommandInProgress := false;
  781.     Result := false;
  782.     exit;
  783.   end;
  784.   repeat
  785.     TheResult := GetNNTPServerResponse( TheReturnString );
  786.     { Put result in progress and status line }
  787.     AddProgressText( TheReturnString );
  788.     ShowProgressText( TheReturnString );
  789.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  790.   NNTPCommandInProgress := false;
  791.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  792.   begin
  793.     { Do clever C formatting trick }
  794.     TheReturnString :=
  795.      DoCStyleFormat( 'Article %d Failed!' ,
  796.       [ TheNumber ] );
  797.     { Put result in progress and status line }
  798.     AddProgressText( TheReturnString );
  799.     ShowProgressErrorText( TheReturnString );
  800.     { Signal error }
  801.     Result := False;
  802.     { leave }
  803.     exit;
  804.   end;
  805.   GetMem( TheReturnPChar , 514 );
  806.   HoldPChar := TheReturnPChar;
  807.   try
  808.     AssignFile( TheArticleFile , TheFileName );
  809.     Rewrite( TheArticleFile );
  810.   except
  811.     MessageDlg( 'Unable to open News Article file ' + TheFileName + '!' ,
  812.      mtError , [mbok],0 );
  813.     Socket1.OutOfBand := 'ABOR'+#13#10;
  814.     repeat
  815.       TheResult := GetNNTPServerResponse( TheReturnString );
  816.       { Put result in progress and status line }
  817.       AddProgressText( TheReturnString );
  818.       ShowProgressText( TheReturnString );
  819.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  820.     result := false;
  821.     exit;
  822.   end;
  823.   repeat
  824.     TheResult := GetNNTPServerExtendedResponse( TheReturnPChar );
  825.     if StrLen( TheReturnPChar ) > 255 then
  826.     begin
  827.       Getmem( TheHoldingPChar , 255 );
  828.       while StrLen( TheReturnPChar ) > 255 do
  829.       begin
  830.         StrCopy( TheHoldingPChar , '' );
  831.         StrMove( TheHoldingPChar , TheReturnPChar , 255 );
  832.         TheReturnPChar := TheReturnPChar + 256;
  833.         TheReturnString := StrPas( TheHoldingPChar );
  834.         Writeln( TheArticleFile , TheReturnString );
  835.       end;
  836.       StrCopy( TheHoldingPChar , '' );
  837.       StrMove( TheHoldingPChar , TheReturnPChar , StrLen( TheReturnPChar ));
  838.       TheReturnString := StrPas( TheHoldingPChar );
  839.       TheReturnString := '\' + TheReturnString;
  840.       Writeln( TheArticleFile , TheReturnString );
  841.       FreeMem( TheHoldingPChar , 255 );
  842.     end
  843.     else
  844.     begin
  845.       TheReturnString := StrPas( TheReturnPChar );
  846.       Writeln( TheArticleFile , TheReturnString );
  847.     end;
  848.   until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  849.   FreeMem( HoldPChar , 514 );
  850.   CloseFile( TheArticleFile );
  851.   Result := true;
  852. end;
  853.  
  854. { This method Gets all the Article Listings for a newsgroup which have not been  }
  855. { Downloaded and gets them into text files. It displays Article count, # & bytes }
  856. { in the status line during the process.                                         }
  857. function TNNTPComponent.DownloadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
  858. var WorkingList   : TList;
  859.     TheNGARecord  : PNewsGroupArticleRecord;
  860.     WorkingGroupNumber,
  861.     WorkingNumber       : Longint;
  862.     Counter_1 : Integer;
  863.     WorkingFileName : String;
  864. begin
  865.   if not SetCurrentNewsGroup( TheNGRecord , false ) then
  866.   begin
  867.     { Abort if can't get newsgroup }
  868.     Result := false;
  869.     exit;
  870.   end;
  871.   with TheNGRecord^ do
  872.   begin
  873.     WorkingGroupNumber := GIDNumber;
  874.     WorkingList := TList( GLTag );
  875.     for Counter_1 := 0 to WorkingList.Count - 1 do
  876.     begin
  877.       TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  878.       with TheNGARecord^ do
  879.       begin
  880.         if not NGADownloaded then
  881.         begin
  882.           NGADownloaded := true;
  883.           WorkingNumber := NGANumber;
  884.           WorkingFileName := 'AR' + IntToStr( WorkingNumber );
  885.           if Length( WorkingFileName ) > 8 then WorkingFileName :=
  886.            Copy( WorkingFileName , 1 , 8 );
  887.           WorkingFileName := WorkingFileName + '.' +
  888.            IntToStr( WorkingGroupNumber );
  889.           NGAArtFileName := WorkingFileName;
  890.           WorkingFileName := NewsPath + '\' + WorkingFileName;
  891.           DownloadArticleListing( WorkingNumber , WorkingFileName );
  892.         end;
  893.       end;
  894.     end;
  895.     GLTag := Longint( WorkingList );
  896.     Result := true;
  897.   end;
  898. end;
  899.  
  900. { This function is similar to the above but uses only marked entries in LB2 }
  901. function TNNTPComponent.DownloadAllMarkedArticleListings(
  902.  TheNGRecord : PNewsGroupRecord; TheListBox : TListBox ) : Boolean;
  903. var WorkingString : String;
  904.     WorkingIndex  : Integer;
  905.     WorkingList   : TList;
  906.     TheNGARecord  : PNewsGroupArticleRecord;
  907.     WorkingGroupNumber,
  908.     WorkingNumber       : Longint;
  909.     Counter_2 ,
  910.     Counter_1 : Integer;
  911.     WorkingFileName : String;
  912. begin
  913.   if not SetCurrentNewsGroup( TheNGRecord , false ) then
  914.   begin
  915.     { Abort if can't get newsgroup }
  916.     Result := false;
  917.     exit;
  918.   end;
  919.   with TheNGRecord^ do
  920.   begin
  921.     WorkingIndex := Pos( 'G' , GFileName );
  922.     WorkingString := Copy( GFileName , WorkingIndex + 1 , 255 );
  923.     WorkingIndex := Pos( '.' , WorkingString );
  924.     WorkingString := Copy( WorkingString , 1 , WorkingIndex - 1 );
  925.     WorkingGroupNumber := StrToInt( WorkingString );
  926.     WorkingList := TList( GLTag );
  927.     for Counter_1 := 0 to TheListBox.Items.Count - 1 do
  928.     begin
  929.       if TheListBox.Selected[ Counter_1 ] then
  930.       begin
  931.         WorkingString :=
  932.          TheFTPComponent.StripBrackets( TheListBox.Items[ Counter_1 ] );
  933.         WorkingNumber := StrToInt( WorkingString );
  934.         TheNGARecord := nil;
  935.         for Counter_2 := 0 to WorkingList.Count - 1 do
  936.         begin
  937.           TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  938.           if TheNGARecord^.NGANumber = WorkingNumber then break;
  939.         end;
  940.         if assigned( TheNGARecord ) then with TheNGARecord^ do
  941.         begin
  942.           if not NGADownloaded then
  943.           begin
  944.             NGADownloaded := true;
  945.             WorkingNumber := NGANumber;
  946.             WorkingFileName := 'AR' + IntToStr( WorkingNumber );
  947.             if Length( WorkingFileName ) > 8 then WorkingFileName :=
  948.              Copy( WorkingFileName , 1 , 8 );
  949.             WorkingFileName := WorkingFileName + '.' +
  950.              IntToStr( WorkingGroupNumber );
  951.             NGAArtFileName := WorkingFileName;
  952.             WorkingFileName := NewsPath + '\' + WorkingFileName;
  953.             DownloadArticleListing( WorkingNumber , WorkingFileName );
  954.           end;
  955.         end;
  956.       end;
  957.     end;
  958.     GLTag := Longint( WorkingList );
  959.     Result := true;
  960.   end;
  961. end;
  962.  
  963. { This method posts a previously-created article to a newsgroup via POST }
  964. function TNNTPComponent.UploadArticleListing(
  965.  TheNGARecord : PNewsGroupArticleRecord ) : Boolean;
  966. var WorkingString : String;
  967.     WorkingFile   : TextFile;
  968.     TheReturnString : String;  { Internal string holder }
  969.     TheResult       : Integer; { Internal int holder    }
  970. begin
  971.   with TheNGARecord^ do
  972.   begin
  973.     NGAPosted := true;
  974.     NGARead := true;
  975.     WorkingString := NewsPath + '\' + NGAArtFileName;
  976.     try
  977.       AssignFile( WorkingFile , WorkingString );
  978.       Reset( WorkingFile );
  979.     except
  980.       MessageDlg( 'Unable to Post due to open error on '
  981.        + Workingstring + '!' , mtError , [mbok],0 );
  982.       Result := false;
  983.       exit;
  984.     end;
  985.     TheReturnString :=
  986.      DoCStyleFormat( 'POST' ,
  987.       [ nil ] );
  988.     { Put result in progress and status line }
  989.     AddProgressText( TheReturnString );
  990.     ShowProgressText( TheReturnString );
  991.     { Begin login sequence with user name }
  992.     TheResult := PerformNNTPCommand( 'POST', [ nil ] );
  993.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  994.     begin
  995.       NNTPCommandInProgress := false;
  996.       Result := false;
  997.       exit;
  998.     end;
  999.     repeat
  1000.       TheResult := GetNNTPServerResponse( TheReturnString );
  1001.       { Put result in progress and status line }
  1002.       AddProgressText( TheReturnString );
  1003.       ShowProgressText( TheReturnString );
  1004.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1005.     repeat
  1006.       NNTPCommandInProgress := false;
  1007.       ReadLn( WorkingFile , WorkingString );
  1008.       TheResult := PerformBlindNNTPCommand( WorkingString );
  1009.       if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1010.       begin
  1011.         NNTPCommandInProgress := false;
  1012.         Result := false;
  1013.         exit;
  1014.       end;
  1015.     until EOF( WorkingFile );
  1016.     CloseFile( WorkingFile );
  1017.     NNTPCommandInProgress := false;
  1018.     TheResult := PerformNNTPCommand( '.' , [ nil ] );
  1019.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1020.     begin
  1021.       NNTPCommandInProgress := false;
  1022.       Result := false;
  1023.       exit;
  1024.     end;
  1025.     repeat
  1026.       TheResult := GetNNTPServerResponse( TheReturnString );
  1027.       { Put result in progress and status line }
  1028.       AddProgressText( TheReturnString );
  1029.       ShowProgressText( TheReturnString );
  1030.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1031.     Result := true;
  1032.   end;
  1033. end;
  1034.  
  1035. { This method takes an entire Newsgroup and scans for SENDER = CIUPKC158 and }
  1036. { if that article has not been posted posts it. (Used by queue system.)      }
  1037. function TNNTPComponent.UploadAllArticleListings( TheNGRecord : PNewsGroupRecord ) : Boolean;
  1038. var WorkingList : TList;
  1039.     Counter_1   : Integer;
  1040.     WorkingNGARecord : PNewsGroupArticleRecord;
  1041. begin
  1042.   with TheNGRecord^ do
  1043.   begin
  1044.     WorkingList := TList( GLTag );
  1045.     for Counter_1 := 0 to WorkingList.Count - 1 do
  1046.     begin
  1047.       WorkingNGARecord :=
  1048.        PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  1049.       with WorkingNGARecord^ do
  1050.       begin
  1051.         if NGASender = 'CIUPKC158' then
  1052.         begin
  1053.           if not NGAPosted then
  1054.           begin
  1055.             UploadArticleListing( WorkingNGARecord );
  1056.             NGAPosted := true;
  1057.           end;
  1058.         end;
  1059.       end;
  1060.     end;
  1061.     GLTag := Longint( WorkingList );
  1062.   end;
  1063.   Result := true;
  1064. end;
  1065.  
  1066. { This sends FTP progress text to the Inet form }
  1067. procedure TNNTPComponent.ShowProgressErrorText( WhatText : String );
  1068. begin
  1069.   CCInetCCForm.ShowProgressErrorText( WhatText );
  1070. end;
  1071.  
  1072. { This is a core function! It performs an FTP command and if no timeout }
  1073. { return a preliminary ok.                                              }
  1074. function TNNTPComponent.PerformNNTPCommand(
  1075.                  TheCommand        : string;
  1076.            const TheArguments      : array of const ) : Integer;
  1077. var TheBuffer : string; { Text buffer }
  1078. begin
  1079.   { If command in progress send back -1 error }
  1080.   if NNTPCommandInProgress then
  1081.   begin
  1082.     Result := -1;
  1083.     exit;
  1084.   end;
  1085.   { Set status variable }
  1086.   NNTPCommandInProgress := True;
  1087.   { Set global error code }
  1088.   GlobalErrorCode := 0;
  1089.   { Format output string }
  1090.   TheBuffer := Format( TheCommand , TheArguments );
  1091.   { Preset failure code }
  1092.   Result := TCPIP_STATUS_FATAL_ERROR;
  1093.   { If invalid socket or no connection abort }
  1094.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  1095.    exit;
  1096.   { Send the buffer plus EOL chars }
  1097.   Socket1.StringData := TheBuffer + #13#10;
  1098.   { if abort due to timeout or other error exit }
  1099.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1100.   { Otherwise return preliminary code }
  1101.   Result := TCPIP_STATUS_PRELIMINARY;
  1102. end;
  1103.  
  1104. { This is a core function! It performs an FTP command and if no timeout }
  1105. { return a preliminary ok.                                              }
  1106. function TNNTPComponent.PerformBlindNNTPCommand( TheCommand : string ) : Integer;
  1107. var TheBuffer : string; { Text buffer }
  1108. begin
  1109.   { If command in progress send back -1 error }
  1110.   if NNTPCommandInProgress then
  1111.   begin
  1112.     Result := -1;
  1113.     exit;
  1114.   end;
  1115.   { Set status variable }
  1116.   NNTPCommandInProgress := True;
  1117.   { Set global error code }
  1118.   GlobalErrorCode := 0;
  1119.   { Format output string }
  1120.   TheBuffer := TheCommand;
  1121.   { Preset failure code }
  1122.   Result := TCPIP_STATUS_FATAL_ERROR;
  1123.   { If invalid socket or no connection abort }
  1124.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  1125.    exit;
  1126.   { Send the buffer plus EOL chars }
  1127.   Socket1.StringData := TheBuffer + #13#10;
  1128.   { if abort due to timeout or other error exit }
  1129.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1130.   { Otherwise return preliminary code }
  1131.   Result := TCPIP_STATUS_PRELIMINARY;
  1132. end;
  1133.  
  1134. { This function gets up to 255 chars of data plus a return code from FTP serv }
  1135. function TNNTPComponent.GetNNTPServerResponse(
  1136.           var ResponseString : String ) : integer;
  1137. var
  1138.   { Buffer string for response line }
  1139.   TheBuffer     : string;
  1140.   { Pointer to the response string }
  1141.   BufferPointer : array[0..255] of char absolute TheBuffer;
  1142.   { Character to check for response code }
  1143.   ResponseChar   : char;
  1144.   { Pointers into returned string }
  1145.   TheIndex ,
  1146.   TheLength     : integer;
  1147.   { Control variable }
  1148.   LeftoversInPan ,
  1149.   Finished      : Boolean;
  1150. begin
  1151.   { Preset fatal error }
  1152.   Result := TCPIP_STATUS_FATAL_ERROR;
  1153.   { Start loop control }
  1154.   LeftoversInPan := false;
  1155.   Finished := false;
  1156.   repeat
  1157.     { Do a peek }
  1158.     TheBuffer := Socket1.PeekData;
  1159.     { If timeout or other error exit }
  1160.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1161.     { Find end of line character }
  1162.     TheIndex := Pos( #10 , TheBuffer );
  1163.     if TheIndex = 0 then
  1164.     begin
  1165.       TheIndex := Pos( #13 , TheBuffer );
  1166.       if TheIndex = 0 then
  1167.       begin
  1168.         TheIndex := Pos( #0 , TheBuffer );
  1169.         if TheIndex = 0 then
  1170.         begin
  1171.           TheIndex := Length( TheBuffer );
  1172.           LeftoversInPan := True;
  1173.           LeftoverText := LeftoverText + TheBuffer;
  1174.           LeftoversOnTable := false;
  1175.         end;
  1176.       end;
  1177.     end;
  1178.     { If an end of line then process the line }
  1179.     if TheIndex > 0 then
  1180.     begin
  1181.       { Get length of string }
  1182.       TheLength := TheIndex;
  1183.       { Receive actual data }
  1184.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  1185.                              @BufferPointer[ 1 ] ,
  1186.                              TheLength              );
  1187.       { Abort if timeout or error }
  1188.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1189.       { Put in the length byte }
  1190.       BufferPointer[ 0 ] := Chr( TheLength );
  1191.       if LeftOversOnTable then
  1192.       begin
  1193.         LeftOversOnTable := false;
  1194.         ResponseString := LeftoverText + TheBuffer;
  1195.         TheBuffer := ResponseString;
  1196.         LeftoverText := '';
  1197.       end;
  1198.       if LeftoversInPan then
  1199.       begin
  1200.         LeftoversInPan := false;
  1201.         LeftoversOnTable := true;
  1202.       end;
  1203.       { Get first number character }
  1204.       ResponseChar := TheBuffer[ 1 ];
  1205.       { Get the value of the number from 1 to 5 }
  1206.       if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  1207.       begin
  1208.         Finished := true;
  1209.         Result := Ord( ResponseChar ) - 48;
  1210.       end;
  1211.     end
  1212.     else
  1213.     begin
  1214.     end;
  1215.   until ( Finished and ( not LeftoversOnTable ));
  1216.   { Return buffer as response string }
  1217.   ResponseString := TheBuffer;
  1218. end;
  1219.  
  1220. { Boilerplate error routine }
  1221. procedure TNNTPComponent.NNTPSocketsErrorOccurred( Sender     : TObject;
  1222.                                                  ErrorCode  : Integer;
  1223.                                                  TheMessage : String   );
  1224. begin
  1225.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  1226. end;
  1227.  
  1228. { This is the FTP components initial connection routine }
  1229. function TNNTPComponent.EstablishConnection(
  1230.           PCRPointer : PConnectionsRecord ) : Boolean;
  1231. var TheReturnString : String;  { Internal string holder }
  1232.     TheResult       : Integer; { Internal int holder    }
  1233. begin
  1234.   { Set default FTP Port value }
  1235.   Socket1.PortName := '119';
  1236.   { Get the ip address from the record }
  1237.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  1238.   { Set blocking mode }
  1239.   Socket1.AsynchMode := False;
  1240.   { Clear condition variables }
  1241.   GlobalErrorCode := 0;
  1242.   GlobalAbortedFlag := false;
  1243.   { Actually attempt to connect }
  1244.   Socket1.CCSockConnect;
  1245.   { Check if connected }
  1246.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  1247.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  1248.   begin { Didn't connect; signal error and abort }
  1249.     { Do clever C formatting trick }
  1250.     TheReturnString :=
  1251.      DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
  1252.       [ PCRPointer^.CIPAddress ] );
  1253.     { Put result in progress and status line }
  1254.     AddProgressText( TheReturnString );
  1255.     ShowProgressErrorText( TheReturnString );
  1256.     { Signal error }
  1257.     Result := False;
  1258.     { leave }
  1259.     exit;
  1260.   end
  1261.   else
  1262.   begin
  1263.     Connection_Established := true;
  1264.     { Signal successful connection }
  1265.     TheReturnString := DoCStyleFormat(
  1266.       'Connected on Local port: %s with IP: %s',
  1267.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  1268.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  1269.     { Put result in progress and status line }
  1270.     CCINetCCForm.AddProgressText( TheReturnString );
  1271.     CCINetCCForm.ShowProgressText( TheReturnString );
  1272.     TheReturnString := DoCStyleFormat(
  1273.      'Connected to Remote port: %s with IP: %s',
  1274.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  1275.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  1276.     { Put result in progress and status line }
  1277.     CCINetCCForm.AddProgressText( TheReturnString );
  1278.     CCINetCCForm.ShowProgressText( TheReturnString );
  1279.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  1280.      [ Socket1.IPAddressName ]);
  1281.     { Put result in progress and status line }
  1282.     CCINetCCForm.AddProgressText( TheReturnString );
  1283.     CCINetCCForm.ShowProgressText( TheReturnString );
  1284.     repeat
  1285.       TheResult := GetNNTPServerResponse( TheReturnString );
  1286.       { Put result in progress and status line }
  1287.       AddProgressText( TheReturnString );
  1288.       ShowProgressText( TheReturnString );
  1289.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1290.     if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1291.     begin
  1292.       { Do clever C formatting trick }
  1293.       TheReturnString :=
  1294.        DoCStyleFormat( 'NNTP Host %s Connection Failed!' ,
  1295.         [ PCRPointer^.CIPAddress ] );
  1296.       { Put result in progress and status line }
  1297.       AddProgressText( TheReturnString );
  1298.       ShowProgressErrorText( TheReturnString );
  1299.       { Signal error }
  1300.       Result := False;
  1301.       { leave }
  1302.       exit;
  1303.     end
  1304.     else Result := true; { Signal no problem }
  1305.   end;
  1306. end;
  1307.  
  1308. { This is the FTP component constructor; it creates 2 sockets }
  1309. constructor TNNTPComponent.Create( AOwner : TComponent );
  1310. begin
  1311.   { do inherited create }
  1312.   inherited Create( AOwner );
  1313.   { Create socket, put in their parent, and error procs }
  1314.   Socket1 := TCCSocket.Create( Self );
  1315.   Socket1.Parent := Self;
  1316.   Socket1.OnErrorOccurred := NNTPSocketsErrorOccurred;
  1317.   { Set up booleans }
  1318.   Connection_Established := false;
  1319.   NNTPCommandInProgress := false;
  1320. end;
  1321.  
  1322. { This is the FTP component destructor; it frees 2 sockets }
  1323. destructor TNNTPComponent.Destroy;
  1324. begin
  1325.   { Free the socket }
  1326.   Socket1.Free;
  1327.   { and call inherited }
  1328.   inherited Destroy;
  1329. end;
  1330.  
  1331. procedure TNNTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  1332. begin
  1333.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  1334. end;
  1335.  
  1336. { This sends FTP progress text to the Inet form }
  1337. procedure TNNTPComponent.AddProgressText( WhatText : String );
  1338. begin
  1339.   CCInetCCForm.AddProgressText( WhatText );
  1340. end;
  1341.  
  1342. { This sends FTP progress text to the Inet form }
  1343. procedure TNNTPComponent.ShowProgressText( WhatText : String );
  1344. begin
  1345.   CCInetCCForm.ShowProgressText( WhatText );
  1346. end;
  1347.  
  1348. { This is the FTP components QUIT routine }
  1349. function TNNTPComponent.Disconnect : Boolean;
  1350. var TheReturnString : String;  { Internal string holder }
  1351.     TheResult       : Integer; { Internal int holder    }
  1352. begin
  1353.   TheReturnString :=
  1354.    DoCStyleFormat( 'QUIT' ,
  1355.     [ nil ] );
  1356.   { Put result in progress and status line }
  1357.   AddProgressText( TheReturnString );
  1358.   ShowProgressText( TheReturnString );
  1359.   { Begin login sequence with user name }
  1360.   PerformNNTPCommand( 'QUIT', [ nil ] );
  1361.   repeat
  1362.     TheResult := GetNNTPServerResponse( TheReturnString );
  1363.     { Put result in progress and status line }
  1364.     AddProgressText( TheReturnString );
  1365.     ShowProgressText( TheReturnString );
  1366.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1367.   NNTPCommandInProgress := false;
  1368.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1369.   begin
  1370.     { Do clever C formatting trick }
  1371.     TheReturnString :=
  1372.      DoCStyleFormat( 'NNTP Host Connection Failed!' ,
  1373.       [ nil ] );
  1374.     { Put result in progress and status line }
  1375.     AddProgressText( TheReturnString );
  1376.     ShowProgressErrorText( TheReturnString );
  1377.     { Signal error }
  1378.     Result := False;
  1379.     { leave }
  1380.     exit;
  1381.   end
  1382.   else Result := true; { Signal no problem }
  1383. end;
  1384.  
  1385. { This is a clever c-style formatting trick }
  1386. function TNNTPComponent.DoCStyleFormat(
  1387.                 TheText      : string;
  1388.           const TheArguments : array of const ) : String;
  1389. begin
  1390.   Result := Format( TheText , TheArguments ) + #13#10;
  1391. end;
  1392.  
  1393.  
  1394. end.
  1395.